home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 11 / Cream of the Crop 11-2.iso / extra_2 / pre_view.zip / WPREVIEW.PAS < prev    next >
Pascal/Delphi Source File  |  1995-10-29  |  53KB  |  1,781 lines
  1. Unit wPreview;
  2.  
  3. interface
  4.  
  5. uses
  6.   Forms, SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Dialogs, ExtCtrls, ShellApi, BTPrint, StdCtrls, Buttons,
  8.   Menus, VBXCtrl, Misc, Truebar;
  9.  
  10. const MaxLpTitles=20;     { max jobs printing at one time }
  11.       MaxPrns=20;         { max printers }
  12.       MaxFonts=10;
  13.       MaxPageLen=58;      { max lines per page (text style printing) }
  14.             MaxPages=30;        { max pages per report (if you want previewing) }
  15.             RefPixPerInchX=300; { reference printer pixels per inch horizontal }
  16.             RefPixPerInchY=300; { reference printer pixels per inch vertical }
  17.       ScrnPixPerInchX=70; { GetDeviceCaps() returns 96, I prefer 70 }
  18.       ScrnPixPerInchY=70; { calc by measuring your screen image and dividing
  19.                             into your screen densities: 640x480, 800x600 }
  20.       ScrollPixels=20;    { when viewing section of large BMP's, scroll 1/2" }
  21.       { following are passed to StartDoc() }
  22.       For8x11=false;  { report designed for 8.5x11 paper size }
  23.       For14x11=true;  { report designed for 14x11 paper size }
  24.             Dlm='|';        { delimiter to use by AddCommand() }
  25.  
  26. type
  27.     PrnInfo=Record
  28.         { It may be available but no selectable in the Printer Select window }
  29.         PrName:string[30];  { Printer name as it appears in win.ini }
  30.     PrPort:string[5];   { Lpt?, 1..3 }
  31.         Queue:string[30];      { Queue name as it appears in Network setup }
  32.       CanSelect:boolean;  { will appear in Select Printer window }
  33.     PrType:integer;     { allows associating Queues with this printer type }
  34.         PrWide:Boolean;     { is a wide carriage style printer }
  35.     end;
  36.   LPMain=class(TObject)
  37.         public
  38.             LptPrinters:array [1..MaxPrns] of PrnInfo;
  39.       PrnCnt,AvailCnt,QueueCnt:integer;
  40.       AvailType,QueueType:array [1..MaxPrns] of integer;
  41.       AvailName,QueueName,QueueTitle:array [1..MaxPrns] of string[40];
  42.             AvailWide:array [1..MaxPrns] of boolean;
  43.       { fixed width fonts }
  44.       FontList:array [1..MaxFonts] of string[40]; { over 5 are variable width }
  45.       { CurDest, WantsPreview set in Select Printer window }
  46.             CurDest:integer;       { current hardcopy destination }
  47.       WantsPreview:boolean;  { wants Report Previewing }
  48.             LastHardCopy:integer;  { last hardcopy printer selected }
  49.             procedure LoadPrinters(FromFile:string);
  50.             function  GetPrinterType(aPrinterName:string):integer;
  51.             function  GetQueueNum(ForQueue:string):Integer;
  52.       { Capture sets: No Banner, No Form Feed, Binary Files (No Tab Expand) }
  53.             procedure Capture(PortNum:integer;ToQueue:string);
  54.             procedure EndCapture(PortNum:integer);
  55.     end;
  56.   TPreview = class(TForm)
  57.     Image1: TImage;
  58.     Panel1: TPanel;
  59.     Label1: TLabel;
  60.     Panel2: TPanel;
  61.     Label3: TLabel;
  62.     BitBtn6: TBitBtn;
  63.     BitBtn1: TBitBtn;
  64.     Panel3: TPanel;
  65.     Label2: TLabel;
  66.     Button1: TButton;
  67.     Button2: TButton;
  68.     Button3: TButton;
  69.     Button4: TButton;
  70.     Label4: TLabel;
  71.     Edit1: TEdit;
  72.     PopupMenu1: TPopupMenu;
  73.     Close1: TMenuItem;
  74.     N1: TMenuItem;
  75.     FirstPg1: TMenuItem;
  76.     PreviousPg1: TMenuItem;
  77.     NextPg1: TMenuItem;
  78.     LastPg1: TMenuItem;
  79.     N2: TMenuItem;
  80.     PrintAll1: TMenuItem;
  81.     PrintPg1: TMenuItem;
  82.     Image2: TImage;
  83.     GoToPg1: TMenuItem;
  84.     N3: TMenuItem;
  85.     Barcode1: TBarcode;
  86.     procedure FormCreate(Sender: TObject);
  87.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  88.     procedure BitBtn6Click(Sender: TObject);
  89.     procedure BitBtn1Click(Sender: TObject);
  90.     procedure Button3Click(Sender: TObject);
  91.     procedure Button4Click(Sender: TObject);
  92.     procedure Button2Click(Sender: TObject);
  93.     procedure Button1Click(Sender: TObject);
  94.     procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  95.     procedure Close1Click(Sender: TObject);
  96.     procedure FirstPg1Click(Sender: TObject);
  97.     procedure PreviousPg1Click(Sender: TObject);
  98.     procedure NextPg1Click(Sender: TObject);
  99.     procedure LastPg1Click(Sender: TObject);
  100.     procedure PrintAll1Click(Sender: TObject);
  101.     procedure PrintPg1Click(Sender: TObject);
  102.     procedure FormShow(Sender: TObject);
  103.     procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
  104.       Shift: TShiftState; X, Y: Integer);
  105.     procedure Image2MouseUp(Sender: TObject; Button: TMouseButton;
  106.       Shift: TShiftState; X, Y: Integer);
  107.     procedure GoToPg1Click(Sender: TObject);
  108.   private
  109.     wCommands:array [1..MaxPages] of tstringlist;
  110.     ViewPageTot:integer;  { Internal Page Counter For Commands[] }
  111.     CurPage:integer;  { Current Page Being Displayed }
  112.     wCurDest:integer;
  113.     wPageTot:integer;
  114.     wRpWide:boolean;
  115.         wShortTitle:string;
  116.     Zoomable,FitToScreen:boolean;
  117.     BigX,BigY:integer;
  118.     FirstTimeBig:boolean;
  119.     useLandScape:boolean;  { set before calling PlayBackPage }
  120.         function  PlayBackPage(ToScreen:boolean;PageNum:integer):boolean;
  121.         procedure SaveCommands(toFile:string);
  122.     procedure SetButtons;
  123.         procedure ShowBigImage;
  124.         procedure LoadCommands(fromFile:string);
  125.   public
  126.     { after StartDoc, before any print command }
  127.         procedure ShowBluePrint(aCaption,TinyBMP,FullBMP:string);
  128.         procedure PrintBluePrint(FullBMP:string);
  129.         procedure PrintCommandFile(aLoadSpec:string);
  130.   end;
  131.   lpr=class(TObject)
  132.       private
  133.             Row,Col:Integer;        { current printer row,col for TextStyle }
  134.             RpWide,FixedWidth:Boolean;      { report width, true if greater than 80 }
  135.       RowHeight,ColWidth,Fixed10Width,Fixed12Width,Fixed8Width:integer;
  136.       AdjZeroX,AdjZeroY:double; {Used in cmpxX & cmpxY to correct 0,0 offset }
  137.             Preview: TPreview;
  138.       aCanvas:TCanvas;        { actual display surface }
  139.             NumOfCopies:Integer;    { number of copies }
  140.             CurDest:integer;        { current hardcopy destination }
  141.             CurFont:integer;        { used in SetGDIFont }
  142.       Condensed:boolean;      { use condensed print }
  143.       RowColStyle:boolean;    { set type of text, set using SetTextStyle }
  144.             FromPreview:boolean;    { used by StartDoc2 and Preview window }
  145.         useLandScape:boolean;   { set in StartDoc }
  146.             Commands:array [1..MaxPages] of tstringlist;
  147.             ViewPageTot:integer;          { used with Commands to track pages }
  148.             InsideCommand:boolean;  { stop recursion of AddCommand() }
  149.       ScaleXby,ScaleYby,VirtualX,VirtualY:longint;
  150.       FromLoadToPrint:boolean; { load an print a command file }
  151.             procedure StartDoc2(ToPreview,Over80Wide:boolean;
  152.               aBriefTitle:string);  { only used by Preview window }
  153.           { prints text to selected canvas: screen or printer }
  154.             procedure Wout(xpos,ypos:integer;aStr:string);
  155.                 { use to change font and style to one of FontList[] items }
  156.             procedure setGDIfont(NewFont:string); { set by pxText() }
  157.       procedure SetTextStyle(forText:boolean);
  158.           { the following is used to correct alignment
  159.             base reference printer is LaserJet at 300 dpi,
  160.                     see RefAspectX and RefAspectY below }
  161.       procedure SetScaleXY;
  162.       procedure SetScaleXY70;
  163.  
  164.                 { scale reference pixels to current canvas }
  165.       function  ScaleX(LaserX:integer):integer;
  166.       function  ScaleY(LaserY:integer):integer;
  167.             { Easiest way to lay out forms, use centimeters from top and left
  168.               edge to position items, then print once on printer it is to be
  169.                 used on, add the adjustments to list in SetZeroXY() routine to
  170.                 correct 0,0 position }
  171.       procedure SetZeroXY(aPrType:integer);
  172.             function  cmpxX(Centimeters:double):integer; { centimeters to pixels }
  173.             function  cmpxY(Centimeters:double):integer; { centimeters to pixels }
  174.             { old style conversion of 75pix/in to reference pixels,
  175.               used in Laz??? commands}
  176.       function  y75px(Virtpx:integer):integer;
  177.       function  x75px(Virtpx:integer):integer;
  178.         public
  179.             ShortTitle:string[70];
  180.             Line,Page,PGlen:integer;
  181.       WantsPreview:boolean;  { wants report previewing }
  182.       WindowDest:boolean;  { raster ops are going to a Window }
  183.       pr:TPrinter;        { used when printing hardcopy }
  184.       { the following vars used to correct alignment when using the
  185.         Windows printing system, adjusted proportionally to reference printer
  186.         output }
  187.       RefAspectX,RefAspectY,PrnAspectY,PrnAspectX:integer;
  188.       RefAspectYdbl,RefAspectXdbl:double;
  189.       CanvasWidth,CanvasHeight:integer;
  190.       Running,Abort:boolean;
  191.       CancelState:integer;
  192.       constructor Create;
  193.             procedure StartDoc(Over80Wide:boolean;aBriefTitle:string);
  194.             procedure StopDoc;
  195.              procedure SetCaption(toStr:string);
  196.             procedure SetDestination; { call before StartDoc() }
  197.       procedure ForceToScreen;  { These two must be after SetDestination, }
  198.       procedure ForceToPrinter; { before StartDoc, to override default dest. }
  199.         function  Cancel:integer; { 0-not running, 1-continue, 2-abort }
  200.             { key print commands should start with AddCommand
  201.               and end with EndCommand to keep recursion from occuring }
  202.             procedure AddCommand(CommandStr:string);
  203.             procedure EndCommand;
  204.  
  205.       { the following are used to emulate a line printer }
  206.             procedure TextFont(NewFont:string); { chng font for line printer style }
  207.             procedure Write(astr:string);
  208.             procedure WriteLn(astr:string);
  209.             procedure P(atrow,atcol:integer;astr:string);
  210.             procedure SetRowCol(toRow,toCol:integer);
  211.             function  pRow:integer;
  212.             function  pCol:integer;
  213.             procedure CrLf;
  214.             procedure Eject;  { used for both Text and Raster styles }
  215.             { converts designated chars to alternate types, for engineering }
  216.             function  SpecChars(istr:string):string;
  217.  
  218.       { actual routines used for X,Y raster printing, params are
  219.               in current reference Pixels and use ScaleX and ScaleY to
  220.         convert to current canvas pixels, usually called by cm???
  221.         or Laz???    commands }
  222.             { aRect values are: left, top, width, height }
  223.             procedure pxLine(aRect:Trect);
  224.             procedure pxText(aPoint:TPoint;uzFont,TheText:string);
  225.             procedure pxImage(IsColor:boolean;aRect:Trect;BMPfile:string);
  226.             procedure pxOrientation(newOrientation:TPrinterOrientation);
  227.             procedure pxBarCode(aRect:Trect;Text:string);
  228.             procedure pxBox(aRect:Trect;GrayLev:integer);
  229.             procedure pxTray(UseTray:integer);
  230.  
  231.       { the following are used for X,Y raster printing, params are
  232.               in Centimeters, easiest way to position items,
  233.         translates Centimeters to Reference pixels, passes to px???? commands }
  234.             procedure cmLine(left,top,width,height:double);
  235.             procedure cmBox(left,top,width,height:double;graylev:integer);
  236.             procedure cmText(left,top:double;uzfont,thetext:string);
  237.             procedure cmImage(IsColor:boolean;left,top:double;BMPfile:string);
  238.             procedure cmBarCode(left,top,width,height:double;Text:string);
  239.  
  240.       { old style laser commands, translates params in old style reference
  241.         system of 75 pixels/in to New Reference Pixels, then to px??? commands }
  242.             { can be deleted }
  243.             procedure LazLine(top,left,width,height:integer);
  244.             procedure LazBox(top,left,width,height,graylev:integer);
  245.             procedure LazText(top,left:integer;uzfont,thetext:string);
  246.             procedure LazBarCode(top,left,width,height:integer;text:string);
  247.             function  LazInchX(Inches:double):integer;    { inches to 75 pixels/in }
  248.             function  LazInchY(Inches:double):integer;    { inches to 75 pixels/in }
  249.     end;
  250.  
  251. var lp:LPmain;
  252.         CurPrinting:array [1..MaxLpTitles] of string30;
  253. procedure StartLinePrinter;
  254. procedure StopLinePrinter;
  255.  
  256. implementation
  257.  
  258. {$R *.DFM}
  259.  
  260. {uses Commoncode, NWCaldef, NWconnec, NWPrint;} { NW??? units from Apiary lib }
  261.  
  262. { WNetGetConnection>0, no queue attached, 0-Queue name
  263.   returned in RemoteName }
  264. function  WNetGetConnection(LocalDev,RemoteName:Pchar;
  265.   var RetSize:integer):integer;far;external 'USER';
  266.  
  267. function GetTitle(aStr:string):string;
  268. var ii:integer;
  269. begin
  270.   ii:=pos('::',upper(aStr));
  271.   result:=aStr;
  272.   if ii>0 then begin
  273.     result:=ltrim(trim(substr(aStr,ii+2,70)));
  274.   end;
  275.   ii:=pos(Dlm+Dlm,aStr);
  276.   if ii>10 then result:=substr(aStr,ii+2,70);
  277. end;
  278.  
  279. procedure TPreview.FormCreate(Sender: TObject);
  280. var ii:integer;
  281. begin
  282.   top:=0;
  283.   width:=627;
  284.   height:=413;
  285.   left:=0;
  286.   CurPage:=1;
  287.     image1.width:=820;
  288.   image1.height:=900;
  289.   panel1.width:=image1.width;
  290.     centerhoriz(self);
  291.     Gen.AddWin('Preview',self);
  292.     for ii:=1 to MaxPages do wCommands[ii]:=nil;
  293.   Zoomable:=false;
  294.   FitToScreen:=false;
  295.   useLandScape:=false;
  296. end;
  297.  
  298. procedure TPreview.FormClose(Sender: TObject; var Action: TCloseAction);
  299. var bool:boolean;
  300.     ii:integer;
  301. begin
  302.   bool:=true;
  303.   if pin('FORMAT',upper(caption)) then begin
  304.     bool:=YesNoBox('Close Preview Window During Formatting?');
  305.   end;
  306.   if bool then begin
  307.       for ii:=1 to wPageTot do begin
  308.           if wCommands[ii]<>nil then wCommands[ii].free;
  309.         end;
  310.       if Zoomable then begin
  311.         Gen.InBluePrint:=false;
  312.         Gen.FullBP.free;  { free memory }
  313.         Gen.FullBP:=TBitMap.Create;
  314.         Gen.TinyBP.free;  { free memory }
  315.       Gen.TinyBP:=TBitMap.Create;
  316.       end;
  317.         Gen.ReleaseWin(self);
  318.       action:=caFree;
  319.   end;
  320. end;
  321.  
  322. procedure Lpr.Wout(xpos,ypos:integer;aStr:string);
  323. var ii,jj,orgx:integer;
  324.     tt:string[20];
  325. begin
  326.   { xpos, ypos should be in laser pixels }
  327.   jj:=length(astr);
  328.   if jj>0 then begin
  329.     with aCanvas do begin
  330.       brush.style:=bsClear;
  331.       if FixedWidth then begin
  332.         if not RowColStyle then begin
  333.           if WindowDest then begin
  334.             ColWidth:=Fixed12Width;
  335.             if font.size=10 then ColWidth:=Fixed10width;
  336.             if font.size=8 then ColWidth:=Fixed8width;
  337.           end else begin
  338.             ColWidth:=Colwidth-1;
  339.             if font.size=10 then ColWidth:=Colwidth-1;
  340.             if font.size=8 then ColWidth:=Colwidth;
  341.           end;
  342.         end;
  343.         orgx:=xpos;
  344.         for ii:=1 to jj do begin
  345.           tt:=copy(astr,ii,1);
  346.           xpos:=orgx+(ii-1)*ColWidth;
  347.           textout(xpos,ypos,tt);
  348.           { Corporate Mono won't produce underlines, have to use Courier }
  349.           if (fsUnderline in font.style) and (font.name=lp.FontList[2]) then begin
  350.             font.name:=lp.FontList[1];
  351.             textout(xpos,ypos,'_');
  352.             font.name:=lp.FontList[2];
  353.           end;
  354.         end;
  355.       end else begin
  356.         textout(xpos,ypos,astr);
  357.       end;
  358.     end;
  359.   end;
  360. end;
  361.  
  362. procedure TPreview.PrintBluePrint(FullBMP:string);
  363. var tlp:TPrinter;
  364.     PrintBP:TBitmap;
  365.     tcanvas:trect;
  366.     ii,jj:integer;
  367. begin
  368.   caption:='Print B/P';
  369.   windowstate:=wsMinimized;
  370.   tlp:=TPrinter.create;
  371.   tlp.orientation:=poLandScape;
  372.   tlp.begindoc;
  373.   PrintBP:=tbitmap.create;
  374.   PrintBP.loadfromfile(FullBMP);
  375.   { get image aspect ratio }
  376.   jj:=(PrintBP.height*10) div PrintBP.width;
  377.   ii:=(tlp.canvas.cliprect.right*jj) div 10;
  378.   tcanvas:=rect(0,0,tlp.canvas.cliprect.right,ii);
  379.   tlp.fCanvas.copymode:=cmSrcCopy;
  380.   tlp.fCanvas.copyrect(tlp.fCanvas.cliprect,PrintBP.canvas,PrintBP.canvas.cliprect);
  381.   {tlp.fCanvas.draw(0,0,PrintBP);}
  382.   tlp.enddoc;
  383.   tlp.destroy;
  384.   PrintBp.free;
  385.   close;
  386. end;
  387.  
  388. procedure Lpr.SetTextStyle(forText:boolean);
  389. begin
  390.     if WantsPreview then begin
  391.     if forText<>RowColStyle then
  392.       AddCommand(' 5'+Dlm+iifs(forText,'TRUE','FALSE'));
  393.   end;
  394.   RowColStyle:=forText;
  395.   EndCommand;
  396. end;
  397.  
  398. procedure Lpr.setGDIfont(NewFont:string);
  399. var ii,jj,OrgFont:integer;
  400.     tstyle:tfontstyles;
  401. begin
  402.   if not empty(NewFont) then begin
  403.     OrgFont:=CurFont;
  404.     with aCanvas do begin
  405.       { when changing font type, must use style '1:12b', where '1:' is style }
  406.       if pin(':',NewFont) then begin
  407.         jj:=pos(':',NewFont);
  408.         if CurFont=0 then CurFont:=2;  { default font type }
  409.         if jj>1 then begin
  410.           ii:=procint(copy(NewFont,1,jj));
  411.           NewFont:=copy(NewFont,jj+1,35);
  412.             if (ii>0) and (ii<=MaxFonts) then begin
  413.               if not empty(lp.FontList[ii]) then CurFont:=ii;
  414.             if ii=2 then CurFont:=1;
  415.             end;
  416.         end;
  417.         if orgfont>0 then begin
  418.           if CurFont<>orgfont then begin
  419.             font.name:=lp.FontList[CurFont];
  420.           end;
  421.         end else font.name:=lp.FontList[CurFont];
  422.       end;
  423.       FixedWidth:=(CurFont<6);
  424.       { if you change size, must also reset style }
  425.       if procint(NewFont)>0 then begin
  426.         font.size:=procint(NewFont);
  427.         font.color:=clBlack;
  428.         tstyle:=[];
  429.         if pin('B',upper(NewFont)) then Include(tstyle,fsbold);
  430.         if pin('U',upper(NewFont)) then Include(tstyle,fsUnderline);
  431.         if pin('I',upper(NewFont)) then Include(tstyle,fsItalic);
  432.         { set back to normal }
  433.         if pin('N',upper(NewFont)) then tstyle:=[];
  434.         acanvas.font.style:=tstyle;
  435.       end else begin
  436.         { change only by passing in just B I or U or a combination }
  437.         tstyle:=[];
  438.         if pin('B',upper(NewFont)) then Include(tstyle,fsbold);
  439.         if pin('U',upper(NewFont)) then Include(tstyle,fsUnderline);
  440.         if pin('I',upper(NewFont)) then Include(tstyle,fsItalic);
  441.         { set back to normal }
  442.         if pin('N',upper(NewFont)) then tstyle:=[];
  443.         font.style:=tstyle;
  444.       end;
  445.       RowHeight:=CanvasHeight div 60;
  446.       if CurFont<6 then begin
  447.         Fixed12Width:=(CanvasWidth div 80)+1;
  448.         Fixed10Width:=(CanvasWidth div 104)+1;
  449.         Fixed8Width:=CanvasWidth div 132;
  450.       end;
  451.       ColWidth:=CanvasWidth div 80;  { 12 pt }
  452.          if font.size=8 then ColWidth:=CanvasWidth div 132;
  453.          if font.size=10 then ColWidth:=CanvasWidth div 104;
  454.     end;
  455.   end;
  456. end;
  457.  
  458. procedure Lpr.SetScaleXY70;
  459. var t1,t2:longint;
  460. begin
  461.   CanvasWidth:=acanvas.cliprect.right;
  462.   CanvasHeight:=acanvas.cliprect.bottom;
  463.   RefAspectX:=RefPixPerInchX;  { my reference printer is a LaserJet II }
  464.   RefAspectY:=RefPixPerInchY;
  465.   RefAspectXdbl:=RefAspectX;
  466.   RefAspectYdbl:=RefAspectY;
  467.   if WindowDest then begin
  468.       PrnAspectX:=ScrnPixPerInchX;
  469.       PrnAspectY:=ScrnPixPerInchX;
  470.   end else begin
  471.       PrnAspectX:=GetDeviceCaps(acanvas.handle,LOGPIXELSX);
  472.       PrnAspectY:=GetDeviceCaps(acanvas.handle,LOGPIXELSY);
  473.     end;
  474.   { ScaleXby and ScaleYby used to adjust reference pixels to
  475.     actual pixels }
  476.   t1:=PrnAspectX;
  477.   t2:=RefAspectX;
  478.   ScaleXby:=(t1*100) div t2;
  479.   t1:=PrnAspectY;
  480.   t2:=RefAspectY;
  481.   ScaleYby:=(t1*100) div t2;
  482.   { VirtualX and VirtualY used to adjust Laz???() Pixels to Reference pixels }
  483.   t1:=70;
  484.   t2:=RefAspectX;
  485.   VirtualX:=(t2*10) div t1;
  486.   t1:=70;
  487.   t2:=RefAspectY;
  488.   VirtualY:=(t2*10) div t1;
  489. end;
  490.  
  491. procedure Lpr.SetScaleXY;
  492. var t1,t2:longint;
  493. begin
  494.   CanvasWidth:=acanvas.cliprect.right;
  495.   CanvasHeight:=acanvas.cliprect.bottom;
  496.   RefAspectX:=RefPixPerInchX;  { my reference printer is a LaserJet II }
  497.   RefAspectY:=RefPixPerInchY;
  498.   RefAspectXdbl:=RefAspectX;
  499.   RefAspectYdbl:=RefAspectY;
  500.     PrnAspectX:=GetDeviceCaps(acanvas.handle,LOGPIXELSX);
  501.   PrnAspectY:=GetDeviceCaps(acanvas.handle,LOGPIXELSY);
  502.   { ScaleXby and ScaleYby used to adjust reference pixels to
  503.     actual pixels }
  504.   t1:=PrnAspectX;
  505.   t2:=RefAspectX;
  506.   ScaleXby:=(t1*100) div t2;
  507.   t1:=PrnAspectY;
  508.   t2:=RefAspectY;
  509.   ScaleYby:=(t1*100) div t2;
  510.   { VirtualX and VirtualY used to adjust Laz???() Pixels to Reference pixels }
  511.   t1:=70;
  512.   t2:=RefAspectX;
  513.   VirtualX:=(t2*10) div t1;
  514.   t1:=70;
  515.   t2:=RefAspectY;
  516.   VirtualY:=(t2*10) div t1;
  517. end;
  518.  
  519. function  Lpr.ScaleX(LaserX:integer):integer;
  520. var longx:longint;
  521. begin
  522.   longx:=LaserX;
  523.   Result:=(longx*ScaleXby) div 100;
  524. end;
  525.  
  526. function  Lpr.ScaleY(LaserY:integer):integer;
  527. var longy:longint;
  528. begin
  529.   longy:=LaserY;
  530.   Result:=(longy*ScaleYby) div 100;
  531. end;
  532.  
  533. function  Lpr.x75px(Virtpx:integer):integer;
  534. var longx:longint;
  535. begin
  536.   longx:=Virtpx;
  537.   Result:=(longx*VirtualX) div 10;
  538. end;
  539.  
  540. function  Lpr.y75px(Virtpx:integer):integer;
  541. var longy:longint;
  542. begin
  543.   longy:=Virtpx;
  544.   Result:=(longy*VirtualY) div 10;
  545. end;
  546.  
  547. constructor lpr.Create;
  548. var ii:integer;
  549. begin
  550.   Abort:=false;
  551.   Running:=false;
  552.   Preview:=nil;
  553.   AdjZeroX:=0.0;
  554.   AdjZeroY:=0.0;
  555.     FromPreview:=false;
  556.   WantsPreview:=false;
  557.   WindowDest:=false;
  558.     for ii:=1 to MaxPages do Commands[ii]:=nil;
  559. end;
  560.  
  561. function LPmain.GetPrinterType(aPrinterName:string):integer;
  562. var ii:integer;
  563.     tt,tt2:string;
  564. begin
  565.   result:=0;
  566.     with lp do begin
  567.       if AvailCnt>0 then begin
  568.           tt:=upper(aPrinterName);
  569.           for ii:=1 to AvailCnt do begin
  570.               tt2:=upper(AvailName[ii]);
  571.                 if tt=tt2 then begin
  572.                   result:=AvailType[ii];
  573.                     break;
  574.                 end;
  575.             end;
  576.         end;
  577.     end;
  578. end;
  579.  
  580. function LPmain.GetQueueNum(ForQueue:string):Integer;
  581. var ii:integer;
  582.     tt,tt2:string;
  583. begin
  584.   result:=0;
  585.     with lp do begin
  586.       if QueueCnt>0 then begin
  587.           tt:=upper(ForQueue);
  588.           for ii:=1 to QueueCnt do begin
  589.               tt2:=upper(QueueName[ii]);
  590.                 if tt=tt2 then begin
  591.                   result:=ii;
  592.                     break;
  593.                 end;
  594.             end;
  595.         end;
  596.     end;
  597. end;
  598.  
  599. procedure Lpr.SetZeroXY(aPrType:integer);
  600. begin
  601.   { Adjust origin for each printer, used in pxCM() }
  602.   AdjZeroX:=0.0;
  603.   AdjZeroY:=0.0;
  604.   case aPrType of
  605.     5,6,7,8:begin  { LaserJet's }
  606.                         AdjZeroX:=-0.7;
  607.                             AdjZeroY:=-1.9;
  608.                 end;
  609.       2,3,4:begin  { Canon BJ-200's }
  610.               AdjZeroX:=-1.1;
  611.               AdjZeroY:=-1.15;
  612.             end;
  613.          10:begin    { HP DeskJet's }
  614.               AdjZeroX:=0.0;
  615.               AdjZeroY:=0.0;
  616.             end;
  617.   end;
  618. end;
  619.  
  620. procedure LPmain.LoadPrinters(FromFile:string);
  621. var tt:string;
  622.         tparscnt,ii,jj,kk:integer;
  623.         plist:tstringlist;
  624.     tp1,tp2:pchar;
  625.     tpars:array [1..MaxPars] of string135;
  626.         pr:TPrinter;
  627. begin
  628.     pr:=TPrinter.create;
  629.   plist:=tstringlist.create;
  630.   plist.LoadFromFile(FromFile);
  631.     { setup printer and queue types first }
  632.     AvailCnt:=0;
  633.     QueueCnt:=0;
  634.     for ii:=1 to MaxPrns do begin
  635.         AvailType[ii]:=0;
  636.         AvailName[ii]:='';
  637.         AvailWide[ii]:=false;
  638.         QueueName[ii]:='';
  639.         QueueTitle[ii]:='';
  640.         QueueType[ii]:=0;
  641.     with LptPrinters[ii] do begin
  642.       PrName:='';
  643.       PrPort:='';
  644.             PrType:=0;
  645.       CanSelect:=True;
  646.       PrWide:=False;
  647.       Queue:='';
  648.     end;
  649.     end;
  650.     for ii:=0 to plist.count-1 do begin
  651.       if pos('pp:',plist[ii])=1 then begin
  652.           split(plist[ii],':',tpars,tparscnt);
  653.             pp(AvailCnt);
  654.             AvailType[AvailCnt]:=procint(tpars[2]);
  655.             AvailName[AvailCnt]:=trim(tpars[3]);
  656.             if tparscnt>3 then AvailWide[AvailCnt]:=pin('Y',upper(tpars[4]));
  657.             { always make the generice printer wide carriage }
  658.             if pin('GENERIC',upper(tpars[3])) then AvailWide[AvailCnt]:=true;
  659.         end;
  660.       if pos('qq:',plist[ii])=1 then begin
  661.           split(plist[ii],':',tpars,tparscnt);
  662.             pp(QueueCnt);
  663.             QueueName[QueueCnt]:=upper(trim(tpars[2]));
  664.             QueueTitle[QueueCnt]:=trim(tpars[3]);
  665.             QueueType[QueueCnt]:=procint(tpars[4]);
  666.         end;
  667.     end;
  668.   PrnCnt:=0;
  669.     if pr.printers.count>0 then begin
  670.     tp1:=stralloc(60);
  671.     tp2:=stralloc(60);
  672.       for ii:=0 to pr.printers.count-1 do begin
  673.       if PrnCnt<MaxPrns then begin
  674.         pp(PrnCnt);
  675.         split(pr.printers[ii],' on ',tpars,tparscnt);
  676.         with LptPrinters[PrnCnt] do begin
  677.           PrName:=trim(tpars[1]);
  678.                     PrType:=GetPrinterType(PrName);
  679.           PrPort:=upper(tpars[2]);
  680.           CanSelect:=True;
  681.           if pin('PUB',PrPort) then CanSelect:=false;
  682.           PrWide:=False;
  683.           strpcopy(tp1,PrPort);
  684.           strpcopy(tp2,'');
  685.           Queue:='';
  686.           kk:=58;  { set tp2 buffer size }
  687.           jj:=WNetGetConnection(tp1,tp2,kk);
  688.           tt:='';
  689.           if jj=0 then begin
  690.               tt:=strpas(tp2);
  691.             { tt should contain something of form: \\MYSERVER\QC_PRINTER }
  692.                 split(tt,'\',tpars,tparscnt);
  693.             Queue:=upper(tpars[tparscnt]);
  694.             jj:=GetQueueNum(Queue);
  695.             { Check Queue printer type matches Windows setup }
  696.             if jj>0 then begin
  697.               if PrType<>QueueType[jj] then Queue:='';
  698.             end else Queue:='';
  699.           end;
  700.         end;
  701.       end;
  702.         end;
  703.     strdispose(tp1);
  704.     strdispose(tp2);
  705.     end;
  706.   { final result of LastHardCopy saved in close method of mainwin }
  707.   WantsPreview:=true;
  708.   CurDest:=pr.printerindex+1;
  709.     pr.free;
  710.   plist.free;
  711. end;
  712.  
  713. procedure Lpr.Write(astr:string);
  714. begin
  715.   p(Line,Pcol,astr);
  716. end;
  717.  
  718. procedure Lpr.WriteLn(astr:string);
  719. begin
  720.   p(line,pCol,astr);
  721.   Col:=0;
  722.   pp(line);
  723. end;
  724.  
  725. procedure Lpr.P(atrow,atcol:integer;astr:string);
  726. var OverPGlen:boolean;
  727. begin
  728.   if Abort then Exit;
  729.     if WantsPreview then AddCommand(' 1'+Dlm+
  730.       inttostr(atrow)+Dlm+inttostr(atcol)+Dlm+astr);
  731.   if atrow<Row then begin
  732.     Eject;
  733.     pp(page);
  734.   end;
  735.   OverPGlen:=false;
  736.   if atrow>=PgLen then begin
  737.     Eject;
  738.       OverPGlen:=true;
  739.     pp(page);
  740.   end;
  741.   Row:=atRow;
  742.   Col:=atcol;
  743.   if length(astr)>0 then begin
  744.     if not WantsPreview then begin
  745.       ColWidth:=iifi(Condensed,Fixed8Width,Fixed12Width);
  746.       wout(col*ColWidth,row*RowHeight,astr);
  747.     end;
  748.     Col:=Col+length(astr);
  749.   end;
  750.   if OverPGlen then begin { must not reset row and col till after print }
  751.     row:=0;
  752.     col:=0;
  753.     line:=-1;
  754.   end;
  755.     EndCommand;
  756. end;
  757.  
  758. procedure Lpr.SetDestination;
  759. { Set printer options using LPmain info.
  760.     Should be called before StartDoc(), but only once, when
  761.   the choice to print has been made, not inside a loop of any kind
  762.     because the printer destination might be changed by some other event }
  763. var ii:integer;
  764. begin
  765.     NumOfCopies:=1;
  766.     CurDest:=lp.CurDest;
  767.   WantsPreview:=lp.WantsPreview;
  768.   WindowDest:=WantsPreview;
  769.     RpWide:=Lp.LptPrinters[curdest].PrWide;
  770. end;
  771.  
  772. procedure Lpr.StartDoc2(ToPreview,Over80Wide:boolean;
  773.   aBriefTitle:string);
  774. begin
  775.   FromPreview:=ToPreview;
  776.     StartDoc(Over80Wide,aBriefTitle);
  777. end;
  778.  
  779. procedure Lpr.StartDoc(Over80Wide:boolean;aBriefTitle:string);
  780. var ii:integer;
  781.     Use70,paper8x11:boolean;
  782.     tt,tt2:string;
  783. begin
  784.     ShortTitle:=aBriefTitle;
  785.   for ii:=1 to MaxLpTitles do begin
  786.       if empty(CurPrinting[ii]) then begin
  787.           CurPrinting[ii]:=ShortTitle;
  788.             break;
  789.         end;
  790.     end;
  791.   Abort:=false;
  792.   Running:=true;
  793.   RpWide:=Over80Wide;
  794.   PgLen:=MaxPageLen;
  795.     NumOfCopies:=1;
  796.   { page starts at 0,0 }
  797.   Row:=0;
  798.   Col:=0;
  799.   Page:=1;
  800.   Line:=0;
  801.   RowHeight:=1;
  802.   ColWidth:=1;
  803.   Use70:=false;
  804.   FromLoadToPrint:=false;
  805.     Fixed12Width:=0;
  806.   Fixed8Width:=0;
  807.   CurFont:=0;
  808.     ViewPageTot:=1;
  809.     Commands[ViewPageTot]:=tstringlist.create;
  810.     pr:=TPrinter.create;
  811.     InsideCommand:=false;
  812.     if (CurDest>0) and (CurDest<4) then pr.printerindex:=CurDest-1;
  813.   ShortTitle:=GetTitle(aBrieftitle);
  814.   Use70:=pin('70::',copy(aBriefTitle,1,ii));
  815.   if not FromPreview then begin
  816.       preview:=tpreview.create(application);
  817.         preview.caption:='Formatting '+ShortTitle;
  818.       preview.ViewPageTot:=1;
  819.       preview.panel1.width:=preview.image1.width;
  820.     Commands[ViewPageTot].insert(0,' 1'+Dlm+' 0'+Dlm+
  821.           iifs(RpWide,'for14x11','for8x11')+Dlm+Dlm+aBriefTitle);
  822.   end;
  823.     if WantsPreview then begin
  824.         WindowDest:=true;
  825.         SetZeroXY(0);
  826.         aCanvas:=Preview.image1.Canvas;
  827.     end else begin
  828.       if FromPreview then begin
  829.           if not WindowDest then begin
  830.           {if useLandScape then pr.Orientation:=poLandScape;}
  831.               SetZeroXY(lp.LptPrinters[lp.CurDest].PrType);
  832.                 pr.begindoc;
  833.                 aCanvas:=pr.canvas;
  834.             end;
  835.         end else begin
  836.             WindowDest:=false;
  837.             preview.caption:='Formatting '+aBriefTitle;
  838.       {if useLandScape then pr.Orientation:=poLandScape;}
  839.             SetZeroXY(lp.LptPrinters[lp.CurDest].PrType);
  840.             pr.begindoc;
  841.             aCanvas:=pr.canvas;
  842.         end;
  843.     end;
  844.     with aCanvas do begin
  845.         if not WindowDest then begin
  846.       paper8x11:=not Lp.LptPrinters[CurDest].PrWide;
  847.         end else begin
  848.       paper8x11:=true;
  849.         end;
  850.     if Use70 then SetScaleXY70
  851.     else SetScaleXY;
  852.     SetTextStyle(true);  { start in text style }
  853.         with font do begin
  854.       SetGDIFont('2:12');
  855.       Condensed:=false;
  856.       if WindowDest then begin
  857.         SetGDIFont('2:10');
  858.       end;
  859.             if RpWide And paper8x11 then begin
  860.         Condensed:=true;
  861.           SetGDIFont('2:8');
  862.             end;
  863.         end;
  864.     end;
  865. end;
  866.  
  867. procedure Lpr.StopDoc;
  868. var ii:integer;
  869. begin
  870.   for ii:=1 to MaxLpTitles do begin
  871.       if ShortTitle=CurPrinting[ii] then begin
  872.           CurPrinting[ii]:='';
  873.             break;
  874.         end;
  875.     end;
  876.     if not WindowDest then begin
  877.         preview.caption:='Printing '+ShortTitle;
  878.     if FromLoadToPrint then begin
  879.     { special case when commands loaded from file }
  880.         pr.Abort; { close current printer device, handled by PlayBackPage }
  881.       preview.wCurDest:=CurDest;
  882.       preview.wPageTot:=ViewPageTot;
  883.       for ii:=1 to ViewPageTot do begin
  884.         preview.wCommands[ii]:=tstringlist.create;
  885.         preview.wCommands[ii].assign(Commands[ii]);
  886.         Commands[ii].free;
  887.       end;
  888.       { keep track of StartDoc() settings }
  889.       preview.wRpWide:=RpWide;
  890.       preview.wShortTitle:=ShortTitle;
  891.       preview.playbackPage(false,0);
  892.     end else pr.EndDoc;
  893.     preview.close;
  894.     end;
  895.     pr.free;
  896.   Running:=false;
  897.   if WantsPreview then begin
  898.     preview.wCurDest:=CurDest;
  899.     preview.wPageTot:=ViewPageTot;
  900.         for ii:=1 to ViewPageTot do begin
  901.       preview.wCommands[ii]:=tstringlist.create;
  902.           preview.wCommands[ii].assign(Commands[ii]);
  903.             Commands[ii].free;
  904.         end;
  905.         { keep track of StartDoc() settings }
  906.     preview.wRpWide:=RpWide;
  907.         preview.wShortTitle:=ShortTitle;
  908.     preview.CurPage:=1;
  909.     preview.PlayBackPage(true,1);
  910.     preview.setbuttons;
  911.   end;
  912. end;
  913.  
  914.  
  915. procedure Lpr.SetRowCol(toRow,toCol:integer);
  916. begin
  917.   if Abort then Exit;
  918.     if WantsPreview then AddCommand(' 2'+Dlm+inttostr(torow)+Dlm+
  919.     inttostr(tocol));
  920.   Col:=toCol;
  921.   Row:=toRow;
  922.     EndCommand;
  923. end;
  924.  
  925.  
  926. procedure Lpr.CrLf;
  927. begin
  928.   if Abort then Exit;
  929.     if WantsPreview then AddCommand(' 3');
  930.     pp(Row);
  931.   Col:=0;
  932.     EndCommand;
  933. end;
  934.  
  935.  
  936. procedure Lpr.Eject;
  937. begin
  938.   if Abort then Exit;
  939.     if not WindowDest then pr.newpage
  940.   else begin
  941.         if ViewPageTot<MaxPages then begin
  942.             pp(ViewPageTot);
  943.       Commands[ViewPageTot]:=tstringlist.create;
  944.     end;
  945.   end;
  946.   Row:=0;
  947.   Line:=0;
  948.   Col:=0;
  949. end;
  950.  
  951. function Lpr.pRow:integer;
  952. begin
  953.   Result:=Row;
  954. end;
  955.  
  956. function Lpr.pCol:integer;
  957. begin
  958.     Result:=Col;
  959. end;
  960.  
  961. function Lpr.SpecChars(istr:string):string;
  962. var ii,tcnt:integer;
  963.     tst:string[10];  { special chars ~ ` ^ }
  964.         tt:string[3];
  965.         tarr:array [1..30] of string135;
  966. begin
  967.   ii:=pos('+/-',istr);
  968.   if ii>0 then begin
  969.     tcnt:=0;
  970.     split(istr,'+/-',tarr,tcnt);
  971.     istr:=unsplit(tarr,'~',tcnt);
  972.   end;
  973.   for ii:=1 to length(istr) do begin
  974.     tst:=Copy(istr,ii,1);
  975.     if tst=Dlm then begin  { degree }
  976.       istr[ii]:=chr(176);
  977.     End Else
  978.     Begin
  979.       if tst='~' then begin  { +/- symbol }
  980.         istr[ii]:=chr(177);
  981.       End Else
  982.       Begin
  983.         if tst='^' then begin  { Greek theta character }
  984.           istr[ii]:=chr(216);
  985.         End Else
  986.         Begin
  987.           if tst='_' then begin  { replace underscores with spaces }
  988.             istr[ii]:=' ';
  989.           End;
  990.         End;
  991.       End;
  992.     End;
  993.   End;
  994.   Result:=istr;
  995. end;
  996.  
  997. procedure Lpr.pxTray(usetray:integer);
  998. var p1,r1:integer;
  999.     prt:string[20];
  1000. begin
  1001.   if Abort then Exit;
  1002.     if WantsPreview then AddCommand('28'+Dlm+inttostr(usetray))
  1003.   else begin
  1004.       { not written yet }
  1005.   end;
  1006.     EndCommand;
  1007. end;
  1008.  
  1009. function Lpr.cmpxX(Centimeters:double):integer; { centimeters to pixels }
  1010. var ii:integer;
  1011. begin
  1012.   ii:=procint(strd(((Centimeters+AdjZeroX)/2.54)*RefAspectXdbl,0));
  1013.   result:=ii;
  1014. end;
  1015.  
  1016. function Lpr.cmpxY(Centimeters:double):integer; { centimeters to pixels }
  1017. var ii:integer;
  1018. begin
  1019.   ii:=procint(strd(((Centimeters+AdjZeroY)/2.54)*RefAspectYdbl,0));
  1020.   result:=ii;
  1021. end;
  1022.  
  1023. procedure Lpr.cmLine(left,top,width,height:double);
  1024. begin
  1025.     pxLine(Rect(cmpxX(left),cmpxY(top),cmpxX(width),cmpxY(height)));
  1026. end;
  1027.  
  1028. procedure Lpr.cmBox(left,top,width,height:double;graylev:integer);
  1029. begin
  1030.     pxBox(Rect(cmpxX(left),cmpxY(top),cmpxX(width),cmpxY(height)),GrayLev);
  1031. end;
  1032.  
  1033. procedure Lpr.cmText(left,top:double;uzfont,thetext:string);
  1034. begin
  1035.     pxText(Point(cmpxX(left),cmpxY(top)),uzFont,TheText);
  1036. end;
  1037.  
  1038. procedure Lpr.cmImage(IsColor:boolean;left,top:double;BMPfile:string);
  1039. begin
  1040.     pxImage(IsColor,Rect(cmpxX(left),cmpxY(top),0,0),BMPfile);
  1041. end;
  1042.  
  1043. procedure Lpr.cmBarCode(left,top,width,height:double;Text:string);
  1044. begin
  1045.     pxBarCode(Rect(cmpxX(left),cmpxY(top),cmpxX(width),cmpxY(height)),Text);
  1046. end;
  1047.  
  1048. procedure Lpr.LazLine(top,left,width,height:integer);
  1049. begin
  1050.     pxLine(Rect(x75px(left),y75px(top+7),x75px(width),y75px(height)));
  1051. end;
  1052.  
  1053. procedure Lpr.LazBox(top,left,width,height,graylev:integer);
  1054. begin
  1055.     pxBox(Rect(x75px(left),y75px(top+7),x75px(width),y75px(height)),GrayLev);
  1056. end;
  1057.  
  1058. procedure Lpr.LazText(top,left:integer;uzfont,thetext:string);
  1059. begin
  1060.   SetTextStyle(false);
  1061.   pxText(Point(x75px(left),y75px(top-3)),uzFont,TheText);
  1062. end;
  1063.  
  1064. procedure Lpr.LazBarCode(top,left,width,height:integer;text:string);
  1065. begin
  1066.     pxBarCode(Rect(x75px(left),y75px(top),x75px(width),y75px(height)),Text);
  1067. end;
  1068.  
  1069. procedure Lpr.pxLine(aRect:Trect);
  1070. begin
  1071.   if Abort then Exit;
  1072.   if WantsPreview then AddCommand('21'+Dlm+
  1073.     ltrim(stri(arect.left,5))+Dlm+ltrim(stri(arect.top,5))+Dlm+
  1074.     ltrim(stri(arect.right,5))+Dlm+ltrim(stri(arect.bottom,5)))
  1075.   else begin
  1076.     with aCanvas do begin
  1077.       { if right>bottom then horizontal line }
  1078.       if arect.right>arect.bottom then pen.width:=arect.bottom
  1079.       else pen.width:=arect.right;
  1080.       if WindowDest then pen.width:=2;
  1081.       brush.style:=bsClear;
  1082.       moveto(ScaleX(arect.left),ScaleY(arect.top));
  1083.       if arect.right>arect.bottom then  { horizontal line }
  1084.         lineto(ScaleX(arect.left+arect.right),ScaleY(arect.top))
  1085.       else                  { vertical line }
  1086.         lineto(ScaleX(arect.left),ScaleY(arect.top+arect.bottom));
  1087.     end;
  1088.   end;
  1089.     EndCommand;
  1090. end;
  1091.  
  1092. procedure Lpr.pxBox(aRect:Trect;GrayLev:integer);
  1093. begin
  1094.   if Abort then Exit;
  1095.   if WantsPreview then AddCommand('22'+Dlm+
  1096.     ltrim(stri(arect.left,5))+Dlm+ltrim(stri(arect.top,5))+Dlm+
  1097.     ltrim(stri(arect.right,5))+Dlm+ltrim(stri(arect.bottom,5))+Dlm+
  1098.     ltrim(stri(graylev,5)))
  1099.   else begin
  1100.     with aCanvas do begin
  1101.       { if i3>i4 then its a horizontal box }
  1102.       brush.style:=bsSolid;
  1103.       if graylev=0 then brush.color:=clBlack else
  1104.         if graylev=1 then brush.color:=clWhite else begin
  1105.           { must use Yellow when printing light gray on paper }
  1106.           if WindowDest then brush.color:=clAqua else brush.color:=clYellow;
  1107.         end;
  1108.       fillrect(rect(ScaleX(arect.left),ScaleY(arect.top),
  1109.         ScaleX(arect.left+arect.right),ScaleY(arect.top+arect.bottom)));
  1110.     end;
  1111.   end;
  1112.     EndCommand;
  1113. end;
  1114.  
  1115. procedure Lpr.pxOrientation(newOrientation:TPrinterOrientation);
  1116. begin
  1117.   if WantsPreview then AddCommand('26'+Dlm+
  1118.       iifs(newOrientation=poPortrait,'PORTRAIT','LANDSCAPE'))
  1119.     else begin
  1120.       if Not WindowDest then begin
  1121.           pr.Orientation:=newOrientation;
  1122.           aCanvas:=pr.Canvas;
  1123.         end;
  1124.     end;
  1125. end;
  1126.  
  1127. procedure Lpr.pxImage(IsColor:boolean;aRect:Trect;BMPfile:string);
  1128. var MustScale:boolean;
  1129. begin
  1130.   if Abort then Exit;
  1131.   if WantsPreview then AddCommand('25'+Dlm+iifs(IsColor,'TRUE','FALSE')+Dlm+
  1132.     ltrim(stri(arect.left,5))+Dlm+ltrim(stri(arect.top,5))+Dlm+
  1133.     ltrim(stri(arect.right,5))+Dlm+ltrim(stri(arect.bottom,5))+Dlm+BMPfile)
  1134.   else begin
  1135.       Gen.PrintBP.loadfromfile(BMPfile);
  1136.     aCanvas.Draw(ScaleX(arect.left),ScaleY(arect.top),Gen.PrintBP);
  1137.   end;
  1138.   EndCommand;
  1139. end;
  1140.  
  1141. procedure TPreview.ShowBigImage;
  1142. var tt,ll:integer;
  1143.     halfx,halfy,adjx,adjy,tx,ty:double;
  1144.     tr:trect;
  1145. begin
  1146.   if FitToScreen then begin
  1147.     image1.visible:=false;
  1148.     image2.visible:=true;
  1149.       SetButtons;
  1150.   end else begin
  1151.     image2.visible:=false;
  1152.     if FirstTimeBig then MouseWait;
  1153.     with image1 do begin
  1154.         adjx:=Gen.FullBP.width/width;
  1155.         adjy:=Gen.FullBP.height/height;
  1156.       { adjust BigX and BigY to correct relative position }
  1157.       tx:=BigX;
  1158.       ty:=BigY;
  1159.       { Scale X and Y from Image coords to Bitmap position }
  1160.       tX:=tX*adjx;
  1161.       tY:=tY*adjy;
  1162.       halfx:=width div 2;
  1163.       halfy:=height div 2;
  1164.       { set X dimensions }
  1165.             ll:=procint(strd(tX-halfx,0));
  1166.       if ll<0 then ll:=0;
  1167.       if ll>(gen.fullBP.width-width) then ll:=gen.fullBP.width-width;
  1168.       { set Y dimensions }
  1169.             tt:=procint(strd(tY-halfy,0));
  1170.       if tt<0 then tt:=0;
  1171.       if tt>(gen.fullBP.height-height) then tt:=gen.fullBP.height-height;
  1172.       tr:=rect(ll,tt,ll+width-1,tt+height-1);
  1173.           canvas.copyrect(canvas.cliprect,Gen.FullBP.canvas,tr);
  1174.       if ll>0 then button1.enabled:=true
  1175.       else button1.enabled:=false;
  1176.       if tt>0 then button3.enabled:=true
  1177.       else button3.enabled:=false;
  1178.       if ll<(gen.fullBP.width-width) then button4.enabled:=true
  1179.       else button4.enabled:=false;
  1180.       if tt<(gen.fullBP.height-height) then button2.enabled:=true
  1181.       else button2.enabled:=false;
  1182.         visible:=true;
  1183.       DoEvents;
  1184.         if FirstTimeBig then MouseGo;
  1185.       FirstTimeBig:=false;
  1186.     end;
  1187.   end;
  1188. end;
  1189.  
  1190. procedure lpr.SetCaption(toStr:string);
  1191. { call before StopDoc }
  1192. begin
  1193.   ShortTitle:=toStr;
  1194. end;
  1195.  
  1196. procedure TPreview.ShowBluePrint(aCaption,TinyBMP,FullBMP:string);
  1197. begin
  1198.   if Gen.InBluePrint then begin
  1199.     OKbox('Can Only Have One Blue Print Open At A Time');
  1200.     close;
  1201.   end else begin
  1202.         windowstate:=wsNormal;
  1203.     Gen.InBluePrint:=true;
  1204.       Zoomable:=true;
  1205.     image1.width:=613;
  1206.     image1.height:=337;
  1207.     image2.width:=613;
  1208.     image2.height:=337;
  1209.        panel1.width:=image1.width;
  1210.     label1.caption:='Move>';
  1211.        button3.caption:='&Up';
  1212.        button2.caption:='&Down';
  1213.     button1.caption:='&Left';
  1214.        button4.caption:='&Right';
  1215.     caption:=aCaption;
  1216.       FitToScreen:=true;
  1217.       Gen.TinyBP.loadfromfile(TinyBmp);
  1218.       Gen.TinyBP.monochrome:=true;
  1219.       image2.canvas.draw(0,0,Gen.TinyBP);
  1220.       Gen.FullBP.loadfromfile(FullBmp);
  1221.     FirstTimeBig:=true;
  1222.     show;
  1223.       ShowBigImage;
  1224.   end;
  1225. end;
  1226.  
  1227. procedure Lpr.pxText(aPoint:TPoint;uzFont,TheText:string);
  1228. var curcol,atline:integer;
  1229.         tt1,tt2,msg:string135;
  1230.     i1,i2:longint;
  1231. begin
  1232.   if Abort then Exit;
  1233.     with aPoint do begin
  1234.         if WantsPreview then AddCommand('24'+Dlm+
  1235.             ltrim(stri(x,5))+Dlm+ltrim(stri(y,5))+Dlm+uzfont+Dlm+thetext)
  1236.         else begin
  1237.             with aCanvas do begin
  1238.                 setGDIfont(uzfont);
  1239.                 brush.style:=bsClear;
  1240.                 wout(ScaleX(x),ScaleY(y),thetext);
  1241.             end;
  1242.         end;
  1243.     end;
  1244.     EndCommand;
  1245. end;
  1246.  
  1247. procedure Lpr.pxBarCode(aRect:Trect;Text:string);
  1248. begin
  1249.   if WantsPreview then AddCommand('27'+Dlm+
  1250.     stri(arect.left,5)+Dlm+stri(arect.top,5)+Dlm+stri(arect.right,5)+Dlm+
  1251.     stri(arect.bottom,5)+Dlm+text)
  1252.   else begin
  1253.     with preview.barcode1 do begin
  1254.       style:=3;
  1255.       if WindowDest then begin
  1256.         preview.barcode1.visible:=false;
  1257.         preview.barcode1.left:=ScaleX(arect.left);
  1258.         preview.barcode1.top:=ScaleY(arect.top);
  1259.         preview.barcode1.width:=ScaleX(arect.right);
  1260.         preview.barcode1.height:=ScaleY(arect.bottom);
  1261.         preview.barcode1.visible:=true;
  1262.         caption:=text;  { caption must be last item }
  1263.       end else begin
  1264.         caption:=text;
  1265.         printerscalemode:=3;
  1266.         printerleft:=ScaleX(arect.left);
  1267.         printertop:=ScaleY(arect.top);
  1268.         printerwidth:=ScaleX(arect.right);
  1269.         printerheight:=ScaleY(arect.bottom);
  1270.         printerhdc:=acanvas.handle;
  1271.       end;
  1272.     end;
  1273.   end;
  1274.   EndCommand;
  1275. end;
  1276.  
  1277. function  Lpr.LazInchX(Inches:double):integer;    { inches to 75 pixels/in }
  1278. begin
  1279.   result:=procint(strd(Inches*RefAspectXdbl,0));
  1280. end;
  1281.  
  1282. function  Lpr.LazInchY(Inches:double):integer;    { inches to 75 pixels/in }
  1283. begin
  1284.   result:=procint(strd(Inches*RefAspectYdbl,0));
  1285. end;
  1286.  
  1287. procedure Lpr.TextFont(NewFont:string);
  1288. begin
  1289.   if Abort then Exit;
  1290.   SetTextStyle(true);
  1291.     if WantsPreview then AddCommand(' 4'+Dlm+NewFont)
  1292.   else SetGDIfont(NewFont);
  1293.     EndCommand;
  1294. end;
  1295.  
  1296. function Lpr.Cancel:integer;  { usually found in FormClose method }
  1297. var bool:boolean;
  1298. begin
  1299.   Result:=0;
  1300.   if Running then begin
  1301.     bool:=YesNoBox('Cancel Printing');
  1302.     if bool then begin
  1303.       result:=2;  { abort }
  1304.       OKBox('After ''Wait'' Clears, You May Continue');
  1305.     end else result:=1;  { continue formatting }
  1306.   end;
  1307.   CancelState:=Result;
  1308. end;
  1309.  
  1310. procedure StartLinePrinter;
  1311. var ii:integer;
  1312. begin
  1313.   Lp:=LPmain.Create;
  1314.   for ii:=1 to MaxFonts do lp.FontList[ii]:='';
  1315.   lp.FontList[1]:='Courier New';
  1316.   {lp.FontList[2]:='Corporate Mono';}  { from TypeCase 2001 fonts CD collection }
  1317.   { variable width fonts are subscripts over 5 }
  1318.   lp.FontList[6]:='Arial';
  1319.   { setup local printer type }
  1320.   Lp.LoadPrinters('prninit.txt');
  1321. end;
  1322.  
  1323. procedure StopLinePrinter;
  1324. begin
  1325.   Lp.free;
  1326. end;
  1327.  
  1328. procedure Lpr.AddCommand(CommandStr:string);
  1329. begin
  1330.   if not InsideCommand then begin
  1331.       InsideCommand:=true;
  1332.     { if using command below, "ff" in PlayBackPage S/B 3 }
  1333.     {Commands[ViewPageTot].add(stri(ViewPageTot,2)+Dlm+
  1334.       stri(Commands[ViewPageTot].count+1,3)+Dlm+CommandStr); }
  1335.  
  1336.     { if using command below, "ff" in PlayBackPage S/B 2 }
  1337.     Commands[ViewPageTot].add(stri(ViewPageTot,2)+Dlm+CommandStr);
  1338.  
  1339.     { Why 2 ways? I have a frequent short report that only takes up a half
  1340.       page, I store the results of the first in the top half, the next in
  1341.       the bottom half.  Then I use AddStrings() and Sort to merge the two
  1342.       pages before finally printing. }
  1343.     end;
  1344. end;
  1345.  
  1346. procedure Lpr.EndCommand;
  1347. begin
  1348.     InsideCommand:=false;
  1349. end;
  1350.  
  1351. procedure TPreview.LoadCommands(fromFile:string);
  1352. var LoadList:Tstringlist;
  1353.          ii,jj:integer;
  1354. begin
  1355.   LoadList:=tstringlist.create;
  1356.   LoadList.loadfromfile(fromFile);
  1357.   wPageTot:=0;
  1358.   for jj:=1 to MaxPages do begin
  1359.     if wCommands[jj]<>nil then wCommands[jj].clear;
  1360.   end;
  1361.   for jj:=0 to LoadList.Count-1 do begin
  1362.     ii:=strtoint(copy(LoadList[jj],1,2));
  1363.     if ii<1 then ii:=1;
  1364.     if wCommands[ii]=nil then wCommands[ii]:=tstringlist.create;
  1365.     wCommands[ii].Add(LoadList[jj]);
  1366.     if ii>wPageTot then wPageTot:=ii;
  1367.   end;
  1368.   LoadList.free;
  1369. end;
  1370.  
  1371. procedure TPreview.SaveCommands(toFile:string);
  1372. var SaveList:Tstringlist;
  1373.          jj:integer;
  1374. begin
  1375.   SaveList:=tstringlist.create;
  1376.   for jj:=1 to wPageTot do SaveList.AddStrings(wCommands[jj]);
  1377.   SaveList.savetofile(toFile);
  1378.   SaveList.free;
  1379. end;
  1380.  
  1381. function TPreview.PlayBackPage(ToScreen:boolean;PageNum:integer):boolean;
  1382. var lpp:Lpr;
  1383.     pcnt,opt,ii,jj,ff,start,finish:integer;
  1384.         pstr:array [1..8] of string135;
  1385.     tt,tt2:string;
  1386. begin
  1387.   { if Pagenum=0 then print all pages }
  1388.   lpp:=Lpr.Create;
  1389.   lpp.SetDestination;
  1390.   with lpp do begin
  1391.     CurDest:=wCurDest;
  1392.     WantsPreview:=false;
  1393.     WindowDest:=ToScreen;
  1394.     start:=PageNum;
  1395.     finish:=PageNum;
  1396.     if PageNum=0 then begin
  1397.         start:=1;
  1398.         finish:=wPageTot;
  1399.     end;
  1400.         if ToScreen then begin
  1401.             if empty(wShortTitle) then caption:='Preview'
  1402.                 else caption:=trim(wShortTitle);
  1403.       windowstate:=wsNormal;
  1404.           aCanvas:=image1.canvas;
  1405.             StartDoc2(ToScreen,wRpWide,wShortTitle);
  1406.         end else begin
  1407.             if empty(wShortTitle) then lpp.preview.caption:='Printing'
  1408.                 else lpp.preview.caption:='Printing '+trim(wShortTitle);
  1409.       lpp.useLandScape:=self.useLandScape;
  1410.           StartDoc(wRpWide,wShortTitle);
  1411.         end;
  1412.     { debug line}
  1413.     {if Gen.User='BRAD ' then SaveCommands(TempPath('demoInfo.txt'));}
  1414.     for ii:=start to finish do begin
  1415.           { find first entry }
  1416.       if ToScreen then begin
  1417.           image1.canvas.brush.style:=bsSolid;
  1418.         image1.canvas.brush.color:=clWhite;
  1419.         image1.canvas.fillrect(image1.canvas.cliprect);
  1420.         image1.visible:=false;
  1421.         label2.caption:='Pg '+ltrim(stri(start,3))+
  1422.           ' of '+ltrim(stri(wPageTot,3));
  1423.         MouseWait;
  1424.       end;
  1425.             if wCommands[ii].count>0 then begin
  1426.               for jj:=0 to wCommands[ii].count-1 do begin
  1427.           doevents2;
  1428.                     split(wCommands[ii][jj],Dlm,pstr,pcnt);
  1429.           ff:=2;   { first field after page number and/or sequence no. }
  1430.                     opt:=procint(pstr[ff]);
  1431.                     case opt of
  1432.              { Row,Col style reports }
  1433.                        1:p(procint(pstr[ff+1]),procint(pstr[ff+2]),pstr[ff+3]);
  1434.                        2:SetRowCol(procint(pstr[ff+1]),procint(pstr[ff+2]));
  1435.                        3:CrLf;
  1436.                        4:TextFont(pstr[ff+1]);
  1437.              { Special Commands }
  1438.                        5:SetTextStyle(pin('TRUE',pstr[ff+1]));
  1439.                       { Raster style reports and called by above }
  1440.                       21:pxLine(Rect(procint(pstr[ff+1]),procint(pstr[ff+2]),
  1441.                  procint(pstr[ff+3]),procint(pstr[ff+4])));
  1442.                       22:pxBox(Rect(procint(pstr[ff+1]),procint(pstr[ff+2]),
  1443.                  procint(pstr[ff+3]),procint(pstr[ff+4])),procint(pstr[ff+5]));
  1444.                          24:pxText(Point(procint(pstr[ff+1]),procint(pstr[ff+2])),pstr[ff+3],
  1445.                  pstr[ff+4]);
  1446.                         25:pxImage(pin('TRUE',pstr[ff+1]),Rect(procint(pstr[ff+2]),
  1447.                  procint(pstr[ff+3]),
  1448.                  procint(pstr[ff+4]),procint(pstr[ff+5])),pstr[ff+6]);
  1449.                         26:begin
  1450.                              if pin('PORTRAIT',pstr[ff+1]) then
  1451.                                      pxOrientation(poPortrait)
  1452.                                  else
  1453.                                      pxOrientation(poLandScape);
  1454.                              end;
  1455.                         27:pxBarCode(Rect(procint(pstr[ff+1]),procint(pstr[ff+2]),
  1456.                  procint(pstr[ff+3]),procint(pstr[ff+4])),pstr[ff+5]);
  1457.                       28:pxTray(procint(pstr[ff+1]));
  1458.                     end;
  1459.                 end;
  1460.             end else OKbox('Page '+inttostr(ii)+' Is Blank');
  1461.       { last page Eject in StopDoc }
  1462.       if ToScreen then begin
  1463.         MouseGo;
  1464.         SetButtons;
  1465.         image1.visible:=true;
  1466.       end;
  1467.             if not ToScreen and (ii<finish) then Eject;
  1468.     end;
  1469.         StopDoc;
  1470.   end;
  1471.     result:=(lpp.CancelState<>2);  { not cancelled }
  1472.   lpp.free;
  1473. end;
  1474.  
  1475. procedure TPreview.BitBtn6Click(Sender: TObject);
  1476. begin
  1477.   PlayBackPage(false,0);
  1478. end;
  1479.  
  1480. procedure TPreview.BitBtn1Click(Sender: TObject);
  1481. begin
  1482.   PlayBackPage(false,CurPage);
  1483. end;
  1484.  
  1485. procedure TPreview.Button3Click(Sender: TObject);
  1486. begin
  1487.   if zoomable then begin
  1488.     BigY:=BigY-ScrollPixels;
  1489.     if BigY<0 then BigY:=0;
  1490.     ShowBigImage;
  1491.   end else begin
  1492.       Curpage:=1;
  1493.       PlayBackPage(true,1);
  1494.       SetButtons;
  1495.   end;
  1496. end;
  1497.  
  1498. procedure TPreview.Button4Click(Sender: TObject);
  1499. begin
  1500.   if zoomable then begin
  1501.     BigX:=BigX+ScrollPixels;
  1502.     ShowBigImage;
  1503.   end else begin
  1504.       CurPage:=wPageTot;
  1505.       PlayBackPage(true,CurPage);
  1506.       SetButtons;
  1507.   end;
  1508. end;
  1509.  
  1510. procedure TPreview.Button2Click(Sender: TObject);
  1511. begin
  1512.   if zoomable then begin
  1513.     BigY:=BigY+ScrollPixels;
  1514.     ShowBigImage;
  1515.   end else begin
  1516.       if CurPage>1 then begin
  1517.         CurPage:=CurPage-1;
  1518.         PlayBackPage(true,CurPage);
  1519.           SetButtons;
  1520.       end;
  1521.   end;
  1522. end;
  1523.  
  1524. procedure TPreview.Button1Click(Sender: TObject);
  1525. begin
  1526.   if zoomable then begin
  1527.     BigX:=BigX-ScrollPixels;
  1528.     if BigX<0 then BigX:=0;
  1529.     ShowBigImage;
  1530.   end else begin
  1531.       if CurPage<wPageTot then begin
  1532.         CurPage:=CurPage+1;
  1533.         PlayBackPage(true,CurPage);
  1534.         SetButtons;
  1535.         end;
  1536.   end;
  1537. end;
  1538.  
  1539. procedure TPreview.Edit1KeyPress(Sender: TObject; var Key: Char);
  1540. var ii:integer;
  1541. begin
  1542.   if getret(key) then begin
  1543.     ii:=procint(edit1.text);
  1544.     if (ii>0) and (ii<=wPageTot) then begin
  1545.         CurPage:=ii;
  1546.         PlayBackPage(true,CurPage);
  1547.         SetButtons;
  1548.       end;
  1549.   end;
  1550. end;
  1551.  
  1552. procedure TPreview.SetButtons;
  1553. begin
  1554.   if Zoomable then begin
  1555.     button1.enabled:=not FitToScreen;
  1556.     button2.enabled:=not FitToScreen;
  1557.     button3.enabled:=not FitToScreen;
  1558.     button4.enabled:=not FitToScreen;
  1559.     { set popupmenu choices }
  1560.     Firstpg1.enabled:=false;
  1561.     Previouspg1.enabled:=false;
  1562.     bitbtn6.enabled:=false;
  1563.     gotopg1.enabled:=false;
  1564.     bitbtn1.enabled:=false;
  1565.     printall1.enabled:=false;
  1566.     printpg1.enabled:=false;
  1567.     Nextpg1.enabled:=false;
  1568.     Lastpg1.enabled:=false;
  1569.     edit1.enabled:=false;
  1570.   end else begin
  1571.     if wPageTot=1 then begin
  1572.       button1.enabled:=false;
  1573.       button2.enabled:=false;
  1574.       button3.enabled:=false;
  1575.       button4.enabled:=false;
  1576.       { set popupmenu choices }
  1577.       Firstpg1.enabled:=false;
  1578.       Previouspg1.enabled:=false;
  1579.       bitbtn6.enabled:=false;
  1580.       gotopg1.enabled:=false;
  1581.       printall1.enabled:=false;
  1582.       Nextpg1.enabled:=false;
  1583.       Lastpg1.enabled:=false;
  1584.       edit1.enabled:=false;
  1585.     end else begin
  1586.       button1.enabled:=true;
  1587.       button2.enabled:=true;
  1588.       button3.enabled:=true;
  1589.       button4.enabled:=true;
  1590.       Firstpg1.enabled:=true;
  1591.       Previouspg1.enabled:=true;
  1592.       Nextpg1.enabled:=true;
  1593.       Lastpg1.enabled:=true;
  1594.       edit1.enabled:=true;
  1595.       bitbtn6.enabled:=true;
  1596.       gotopg1.enabled:=true;
  1597.       printall1.enabled:=true;
  1598.       if CurPage=1 then begin
  1599.         button3.enabled:=false;
  1600.         button2.enabled:=false;
  1601.         Firstpg1.enabled:=false;
  1602.         Previouspg1.enabled:=false;
  1603.       end;
  1604.       if CurPage=wPageTot then begin
  1605.         button4.enabled:=false;
  1606.         button1.enabled:=false;
  1607.         Nextpg1.enabled:=false;
  1608.         Lastpg1.enabled:=false;
  1609.       end;
  1610.     end;
  1611.   end;
  1612. end;
  1613.  
  1614. procedure Lpr.ForceToScreen;
  1615. begin
  1616.   { override current print dest., force report to Report Preview }
  1617.   WantsPreview:=true;
  1618.   WindowDest:=true;
  1619. end;
  1620.  
  1621. procedure Lpr.ForceToPrinter;
  1622. begin
  1623.   { override current print dest., force report to a printer }
  1624.   WantsPreview:=false;
  1625.   WindowDest:=false;
  1626. end;
  1627.  
  1628. procedure TPreview.Close1Click(Sender: TObject);
  1629. begin
  1630.   Close;
  1631. end;
  1632.  
  1633. procedure TPreview.FirstPg1Click(Sender: TObject);
  1634. begin
  1635.   Curpage:=1;
  1636.   PlayBackPage(true,1);
  1637.   SetButtons;
  1638. end;
  1639.  
  1640. procedure TPreview.PreviousPg1Click(Sender: TObject);
  1641. begin
  1642.   if CurPage>1 then begin
  1643.     CurPage:=CurPage-1;
  1644.     PlayBackPage(true,CurPage);
  1645.       SetButtons;
  1646.   end;
  1647. end;
  1648.  
  1649. procedure TPreview.NextPg1Click(Sender: TObject);
  1650. begin
  1651.   if CurPage<wPageTot then begin
  1652.     CurPage:=CurPage+1;
  1653.     PlayBackPage(true,CurPage);
  1654.     SetButtons;
  1655.     end;
  1656. end;
  1657.  
  1658. procedure TPreview.LastPg1Click(Sender: TObject);
  1659. begin
  1660.   CurPage:=wPageTot;
  1661.   PlayBackPage(true,CurPage);
  1662.   SetButtons;
  1663. end;
  1664.  
  1665. procedure TPreview.PrintAll1Click(Sender: TObject);
  1666. begin
  1667.   PlayBackPage(false,0);
  1668. end;
  1669.  
  1670. procedure TPreview.PrintPg1Click(Sender: TObject);
  1671. begin
  1672.   PlayBackPage(false,CurPage);
  1673. end;
  1674.  
  1675. procedure TPreview.FormShow(Sender: TObject);
  1676. begin
  1677.   top:=0;
  1678.   left:=0;
  1679.   centerhoriz(self);
  1680. end;
  1681.  
  1682. procedure LPmain.Capture(PortNum:integer;ToQueue:string);
  1683. { Code below modified from Apiary Netware Lib, file:
  1684.                   \apiary\examples\sdk\printca1.pas }
  1685. var {Flags1:NWCAPTURE_FLAGS1;
  1686.         Flags2:NWCAPTURE_FLAGS2;
  1687.     Conn:NWCONN_HANDLE;}
  1688.     Server,Lpt,None:array [0..50] of char;
  1689.     code:integer;
  1690. begin
  1691.   { Flag codes: $80 no banner, $40 no tab expansion, $08 no form feed }
  1692.     {if (PortNum>0) and (PortNum<4) then begin
  1693.       if empty(ToQueue) then EndCapture(PortNum)
  1694.       else begin
  1695.       NWGetDefaultConnectionID(Conn);
  1696.       strpcopy(Server,'\\PREC_DIE\'+upper(ToQueue));
  1697.       strpcopy(Lpt,'LPT'+inttostr(PortNum));
  1698.       strpcopy(none,'');
  1699.       EndCapture(PortNum);
  1700.       WNetAddConnection(Server,none,Lpt);
  1701.         code:=NWGetCaptureFlags(PortNum,Flags1,Flags2);
  1702.       Flags1.printFlags:=Flags1.printFlags and (not $80);
  1703.       Flags1.printFlags:=Flags1.printFlags and (not $40);
  1704.       Flags1.printFlags:=Flags1.printFlags or $08;
  1705.         code:=NWSetCaptureFlags(Conn,PortNum,Flags1);
  1706.       end;
  1707.     end else OKbox('Error: Tried To Start Capture On Lpt'+inttostr(Portnum)+
  1708.     ':');}
  1709. end;
  1710.  
  1711. procedure LPmain.EndCapture(PortNum:integer);
  1712. begin
  1713.   if (PortNum>0) and (PortNum<4) then begin
  1714.     {NWFlushCapture(PortNum);
  1715.     NWEndCapture(PortNum);}
  1716.   end else OKbox('Error: Tried To End Capture On Lpt'+inttostr(Portnum)+
  1717.     ':');
  1718. end;
  1719.  
  1720. procedure TPreview.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  1721.   Shift: TShiftState; X, Y: Integer);
  1722. begin
  1723.   if zoomable then begin
  1724.     FitToScreen:=not FitToScreen;
  1725.       BigX:=x;
  1726.       BigY:=Y;
  1727.       ShowBigImage;
  1728.   end;
  1729. end;
  1730.  
  1731. procedure TPreview.Image2MouseUp(Sender: TObject; Button: TMouseButton;
  1732.   Shift: TShiftState; X, Y: Integer);
  1733. begin
  1734.   if zoomable then begin
  1735.       FitToScreen:=not FitToScreen;
  1736.       BigX:=x;
  1737.       BigY:=Y;
  1738.       ShowBigImage;
  1739.   end;
  1740. end;
  1741.  
  1742. procedure TPreview.GoToPg1Click(Sender: TObject);
  1743. var ii:integer;
  1744. begin
  1745.   ii:=procint(InputBox('Go To','Page #',''));
  1746.   if (ii>0) and (ii<=wPageTot) then begin
  1747.     CurPage:=ii;
  1748.     PlayBackPage(true,CurPage);
  1749.     SetButtons;
  1750.   end;
  1751. end;
  1752.  
  1753. procedure TPreview.PrintCommandFile(aLoadSpec:string);
  1754. var ii:integer;
  1755.     tt,tt2:string;
  1756. begin
  1757.     ii:=pos('::',upper(aLoadSpec));
  1758.   if ii>0 then begin
  1759.         tt:=ltrim(trim(substr(aLoadSpec,ii+2,70)));
  1760.     wShortTitle:=aLoadSpec;
  1761.         if not FileExists(tt) then begin
  1762.       OkBox('Pre-Load File Not Found: '+tt);
  1763.       close;
  1764.         end else begin
  1765.             LoadCommands(tt);
  1766.         wCurDest:=lp.curdest;
  1767.           wRpWide:=pin('for14x11',wCommands[1][0]);
  1768.           wShortTitle:=GetTitle(wCommands[1][0]);
  1769.             if lp.WantsPreview then begin
  1770.                 windowstate:=wsNormal;
  1771.               PlayBackPage(true,1);
  1772.             end else begin
  1773.                 windowstate:=wsMinimized;
  1774.               PlayBackPage(false,0);
  1775.             end;
  1776.         end;
  1777.     end;
  1778. end;
  1779.  
  1780. end.
  1781.